home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / 4dos / 4utilsf.zip / 4DESC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-10  |  29KB  |  866 lines
  1. PROGRAM FileDescEditor;
  2. {$A+,B-,D-,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
  3. {$M 8192,0,0}
  4.  
  5. (* ----------------------------------------------------------------------
  6.    A Simple 4DOS File Description Editor
  7.  
  8.    (c) 1992 Copyright by David Frey,         & Tom Bowden
  9.                          Urdorferstrasse 30    1575 Canberra Drive
  10.                          8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  11.                          Switzerland           USA
  12.  
  13.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  14.  
  15.    DISCLAIMER: This program is freeware: you are allowed to use, copy
  16.                and change it free of charge, but you may not sell or hire
  17.                4DESC. The copyright remains in our hands.
  18.  
  19.                If you make any (considerable) changes to the source code,
  20.                please let us know. (send a copy or a listing).
  21.                We would like to see what you have done.
  22.  
  23.                We, David Frey and Tom Bowden, the authors, provide absolutely
  24.                no warranty of any kind. The user of this software takes the
  25.                entire risk of damages, failures, data losses or other
  26.                incidents.
  27.  
  28.    NOTES:      4DESC was modified extensively by Tom Bowden,
  29.                August-October 1992.
  30.  
  31.                Among the changes:
  32.  
  33.                Screen layout now resembles the 4DOS SELECT screen.
  34.                (The original screen had apparently been based on Larry
  35.                Edwards' 4FILES).
  36.  
  37.                The display now is sorted.
  38.  
  39.                The program now is always in edit mode.
  40.  
  41.                Alt-T (cuT to buffer) now is Alt-M (Move to buffer).
  42.                Alt-D now deletes a file description.
  43.                Alt-X now exits the program.
  44.  
  45.                F1 now displays a help screen.
  46.                F2 now changes drive.
  47.                F3 now changes to the highlighted directory.
  48.                F4 now changes to the parent directory.
  49.                F10 now saves the current file descriptions.
  50.  
  51.                The screen colors were changed, and stored as CONST for
  52.                easier maintenance.  VGA is no longer required.
  53.  
  54.                4DESC can now write and display file descriptions for
  55.                directory entries.
  56.  
  57.                SaveDescriptions now strips trailing spaces from
  58.                file extensions and leading and trailing spaces from
  59.                file descriptions.
  60.  
  61.                4DESC does not presently write file descriptions longer
  62.                than 40 characters.  When saving, any longer descriptions
  63.                in the current directory will be truncated.  The user is
  64.                warned when reading a directory having extended file
  65.                descriptions.
  66.  
  67.                Handling of extended program information has not been tested.
  68.  
  69.    ADDITIONS TO TOM BOWDENS'S IMPROVEMENTS BY DAVID FREY:
  70.  
  71. ||             I have split 4DESC.PAS into units:
  72. ||              StringDateHandling, DisplayKeyboardAndCursor, HandleINIFile
  73. ||
  74.                Monochrome / Color display detection. /mono switch.
  75.  
  76.                Insert mode cursor is underline, overwrite is block cursor.
  77.                (as in 4DOS)
  78.  
  79.                Since 4DOS 4.01 has introduced the `DescriptionMax' statement;
  80.                references to fix description lengths have been removed.
  81.  
  82.                4DESC is now international: it chooses the appropriate date
  83.                and time formats on startup. [by using DOS's function $38:
  84.                Get/Set Country Data. DOS get the country information via
  85.                COUNTRY= and COUNTRY.SYS].
  86.  
  87.                4TOOLS.INI file introduced. Colors and Time/Date formats can
  88.                now be changed without recompiling 4DESC.PAS (for people
  89.                without Turbo Pascal). 4DESC checks its startup directory,
  90.                environment variable 4TOOLS and PATH to locate 4TOOLS.INI.
  91.  
  92.                "Change drive" will not change to drives which are not ready.
  93.  
  94.    A few new tweaks by Tom Bowden:
  95.  
  96.                "Change drive" will not change to drives which contain
  97.                no files.
  98.  
  99.                New handling of command line parameters.  The /mono, /help,
  100.                and selected directory params may be used together.  Note
  101.                that the optional selected directory must be the last
  102.                parameter entered.
  103.  
  104.                The status line now displays the 4DOS version (if running
  105.                under 4DOS), and shows "Edit" and Cut" rather than "*"
  106.                and "()".
  107.  
  108.     More additions by David Frey:
  109.  
  110.                Maximum number of files in a directory raised to 417
  111.                descriptions. A warning ("Description file will be truncated")
  112.                will appear if more than MaxDesc files are stored in a
  113.                directory going to be edited with 4DESC.
  114.                This prevents unintentional cutting of your description file.
  115.  
  116.                Yet another function key binding:
  117.                 F3 : View file (with list - whatever list may be
  118.                                 (internal 4DOS, external viewer))
  119.                 F4 : Change Dir
  120.                 F5 : Change to parent
  121.                 F6 : Change drive
  122.  
  123.                In 4TOOLS.INI the LeftJust variable has been added.
  124.  
  125.                Shelling out to 4DOS has been added (Alt-S or Shift-F10)
  126.  
  127.     More additions by Tom Bowden:
  128.  
  129.                In 4TOOLS.INI the FullSize variable has been added.
  130.                Get4DOSVer has been modified to give correct minor version.
  131.  
  132.    ----------------------------------------------------------------------- *)
  133.  
  134.  
  135. USES Crt, Dos, StringDateHandling, DisplayKeyboardAndCursor, HandleINIFile;
  136.  
  137. CONST MaxDescLen = 40;
  138.  
  139. TYPE  NameExtStr = STRING[8+1+3];
  140.       DescStr    = STRING[MaxDescLen];
  141.       TFileData  = RECORD
  142.                      DirSort  : CHAR;
  143.                      Name     : NameExtStr;
  144.                      Size     : STRING[8];
  145.                      Date     : STRING[15];
  146.                      ProgInfo : STRING[64]; (* I hope 64 characters are enough *)
  147.                      Desc     : DescStr;
  148.                    END;
  149.  
  150. CONST MaxDesc     = 61400 DIV SizeOf(TFileData);
  151.       DirSize     = '  <DIR> ';
  152.  
  153. VAR   Description : ARRAY[1..MaxDesc] OF TFileData;
  154.       NrOfFiles   : WORD;
  155.       EdStart     : BYTE;
  156.  
  157.       ActDir      : DirStr;
  158.       StartDir    : DirStr;
  159.  
  160.       StartIndex  : BYTE;
  161.       Index       : INTEGER;
  162.  
  163.       CutPasteDesc: DescStr;
  164.       Changed     : BOOLEAN;
  165.       IORes       : INTEGER;
  166.  
  167.       NewDir      : DirStr;
  168.       NewName     : NameStr;
  169.       NewExt      : ExtStr;
  170.  
  171.       FirstParam  : STRING[2];
  172.       i           : BYTE;
  173.       DoShowHelp  : BOOLEAN;
  174.  
  175. (*-------------------------------------------------------- Display-Routines *)
  176. PROCEDURE WriteFileEntry(Index: INTEGER; Hilighted: BOOLEAN);
  177.  
  178. BEGIN
  179.  GotoXY(1,2+Index-StartIndex);
  180.  IF  Index <= NrOfFiles THEN
  181.   WITH Description[Index] DO
  182.    BEGIN
  183.     IF Hilighted THEN
  184.      BEGIN TextColor(SelectFg); TextBackGround(SelectBg); END
  185.     ELSE
  186.      BEGIN
  187.       TextBackGround(NormBg);
  188.       IF Size <> DirSize THEN TextColor(NormFg)
  189.                          ELSE TextColor(DirFg)
  190.      END;
  191.     Write(' ',Name,Size,' ',Date,'  ');
  192.     GotoXY(EdStart,2+Index-StartIndex); Write(Desc); ClrEol;
  193.    END
  194.  ELSE ClrEol;
  195. END;  (* WriteFileEntry *)
  196.  
  197. PROCEDURE DrawDirLine;
  198.  
  199. BEGIN
  200.  {$I-}
  201.  GetDir(0,ActDir);
  202.  IF ActDir[Length(ActDir)] <> '\' THEN ActDir := ActDir + '\';
  203.  UpString(ActDir);
  204.  TextColor(DirFg); TextBackGround(NormBg);
  205.  GotoXY(1,2); Write(' ',ActDir); ClrEol;
  206. END; (* DrawDirLine *)
  207.  
  208. PROCEDURE ReDrawScreen;
  209.  
  210. VAR Index: INTEGER;
  211.  
  212. BEGIN
  213.  {$I-}
  214.  GetDir(0,ActDir);
  215.  FOR Index := StartIndex+1 TO StartIndex+MaxLines-3 DO
  216.   WriteFileEntry(Index,FALSE);
  217. END; (* ReDrawScreen *)
  218.  
  219.  
  220. (*-------------------------------------------------------- Sort-Directory *)
  221. PROCEDURE SortArray;     (* Straight selection sort algorithm by N. Wirth *)
  222.  
  223. VAR i, j, k   : INTEGER;
  224.     TempDesc : TFileData;
  225.  
  226. BEGIN
  227.  FOR i := 1 TO NrOfFiles-1 DO
  228.   BEGIN
  229.    k := i;
  230.    TempDesc := Description[i];
  231.    FOR j := i+1 TO NrOfFiles DO
  232.     IF Description[j].DirSort+Description[j].Name < TempDesc.DirSort+TempDesc.Name THEN
  233.      BEGIN
  234.       k := j;
  235.       TempDesc := Description[j];
  236.      END;
  237.    Description[k] := Description[i];
  238.    Description[i] := TempDesc;
  239.   END;
  240. END;  (* SortArray *)
  241.  
  242. (*-------------------------------------------------------- Read-Directory *)
  243. PROCEDURE ReadFiles;
  244.  
  245. VAR Search         : SearchRec;
  246.     Dir            : DirStr;
  247.     BaseName       : NameStr;
  248.     Ext            : ExtStr;
  249.     Time           : DateTime;
  250.  
  251.     DescFileExists : BOOLEAN;
  252.     DescFound      : BOOLEAN;
  253.     DescLong       : BOOLEAN;
  254.     DescFile       : TEXT;
  255.     DescLine       : STRING;
  256.     DescStart      : BYTE;
  257.     DescEnd        : BYTE;
  258.     i              : BYTE;
  259.     ch             : WORD;
  260.  
  261. BEGIN
  262.  NrOfFiles  := 0;
  263.  Changed    := FALSE; DescLong   := FALSE;
  264.  Index      := 1; StartIndex := 0;
  265.  
  266.  FindFirst('DESCRIPT.ION',Hidden + Archive,Search);
  267.  DescFileExists := (DosError = 0);
  268.  {$I-}
  269.  IF DescFileExists THEN Assign(DescFile,'DESCRIPT.ION');
  270.  
  271.  FindFirst('*.*',ReadOnly+Hidden+Archive+Directory, Search);
  272.  WHILE (DosError = 0) AND (NrOfFiles < MaxDesc) DO
  273.   BEGIN
  274.    DownString(Search.Name);
  275.    INC(NrOfFiles);
  276.    WITH Description[NrOfFiles] DO
  277.     BEGIN
  278.      UnpackTime(Search.Time,Time);
  279.      Date     := FormDate(Time)+' '+FormTime(Time);
  280.      ProgInfo := '';
  281.      Desc     := '';
  282.  
  283.      IF Search.Attr AND Directory = Directory THEN
  284.       BEGIN
  285.        Name := UpStr(Search.Name);
  286.        Size := DirSize;
  287.        DirSort := '0';  (* Force directories ahead of files in sorted display. *)
  288.       END
  289.      ELSE
  290.       BEGIN
  291.        FSplit(Search.Name,Dir,Basename,Ext);
  292.        IF NoJust   THEN Name := BaseName+Ext
  293.                    ELSE Name := BaseName+Chars(' ',8-Length(BaseName))+Ext;
  294.        IF FullSize THEN Str(Search.Size:8,Size)
  295.                    ELSE Size := FormattedLongIntStr(Search.Size DIV 1024,7)+'K';
  296.        DirSort := '1';
  297.       END; (* if ... and directory ... else *)
  298.      WHILE Length(Name) < 12 DO Name := Name+' ';
  299.  
  300.      IF DescFileExists THEN
  301.       BEGIN
  302.        {$I-}
  303.        Reset(DescFile);
  304.        REPEAT
  305.         ReadLn(DescFile,DescLine);
  306.         DescStart := Pos(' ',DescLine);
  307.         DescFound := (DescStart < Length(DescLine)) AND
  308.                     ((Copy(DescLine,1,DescStart-1) = Search.Name) OR
  309.                      (Copy(DescLine,1,DescSTart-1) = UpStr(Search.Name)))
  310.        UNTIL DescFound OR Eof(DescFile);
  311.        IF DescFound THEN
  312.         BEGIN
  313.          DescEnd := Pos(#4,DescLine);
  314.          IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  315.          IF (DescEnd-1) - (DescStart+1) > MaxDescLen THEN DescLong := TRUE;
  316.          ProgInfo:= Copy(DescLine,DescEnd,255);
  317.          Desc    := Copy(DescLine,DescStart+1,DescEnd-1);
  318.          StripLeadingSpaces(Desc);
  319.         END;
  320.       END; (* if DescFileExists *)
  321.     END; (* with Description do *)
  322.    FindNext(Search);
  323.   END; (* while *)
  324.  IF NrOfFiles = MaxDesc THEN
  325.   BEGIN
  326.    TextColor(NormFg); TextBackGround(NormBg);
  327.    FOR i := 3 TO MaxLines-1 DO
  328.     BEGIN
  329.      GotoXY(1,i); ClrEol;
  330.     END;
  331.    ReportError('Warning! Too many files in directory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed);
  332.   END;
  333.  
  334.  {$I-}
  335.  IF DescFileExists THEN Close(DescFile);
  336.  
  337.  IF NrOfFiles > 1 THEN SortArray;
  338.  
  339.  IF NrOfFiles > 0 THEN
  340.   BEGIN
  341.    DrawMainScreen(Index,NrOfFiles);
  342.    DrawDirLine;
  343.   END;
  344.  
  345.  IF DescLong THEN
  346.   BEGIN
  347.    TextColor(NormFg); TextBackGround(NormBg);
  348.    FOR i := 3 TO MaxLines-1 DO
  349.     BEGIN
  350.      GotoXY(1,i); ClrEol;
  351.     END;
  352.    ReportError('Warning! Some descriptions are too long; they will be truncated. Press any key.',(CutPasteDesc <> ''),Changed);
  353.   END;
  354. END;  (* ReadFiles *)
  355.  
  356. (*-------------------------------------------------------- Save Descriptions *)
  357. PROCEDURE SaveDescriptions;
  358.  
  359. VAR DescFile : TEXT;
  360.     DescSaved: BOOLEAN;
  361.     Dir      : DirStr;
  362.     BaseName : NameStr;
  363.     Ext      : ExtStr;
  364.     Time     : DateTime;
  365.     i        : INTEGER;
  366.     ch       : WORD;
  367.  
  368. BEGIN
  369.  DescSaved := FALSE;
  370.  IF DiskFree(0) < NrOfFiles*SizeOf(TFileData) THEN
  371.   ReportError(' Probably out of disk space. Nevertheless trying to save DESCRIPT.ION...',(CutPasteDesc <> ''),Changed);
  372.  
  373.  {$I-}
  374.  Assign(DescFile,'DESCRIPT.ION');
  375.  SetFAttr(DescFile,Archive);
  376.  Rewrite(DescFile);
  377.  IF IOResult > 0 THEN ReportError(' Unable to write DESCRIPT.ION ! ',(CutPasteDesc <> ''),Changed)
  378.  ELSE
  379.   BEGIN
  380.    FOR i := 1 TO NrOfFiles DO
  381.     WITH Description[i] DO
  382.      IF Desc <> '' THEN
  383.       BEGIN
  384.        FSplit(Name,Dir,Basename,Ext);
  385.        StripTrailingSpaces(BaseName);
  386.        Write(DescFile,BaseName);
  387.  
  388.        StripLeadingSpaces(Ext);
  389.        StripTrailingSpaces(Ext);
  390.        IF Ext <> '' THEN Write(DescFile,Ext);
  391.  
  392.        StripLeadingSpaces(Desc);
  393.        StripTrailingSpaces(Desc);
  394.        Write(DescFile,' ',Desc);
  395.        IF ProgInfo <> '' THEN Write(DescFile,#4,ProgInfo);
  396.        WriteLn(DescFile);
  397.        DescSaved := TRUE;
  398.       END;
  399.    {$I-}
  400.    Close(DescFile);
  401.    IF IOResult > 0 THEN ReportError(' Unable to write DESCRIPT.ION ! ',(CutPasteDesc <> ''),Changed)
  402.    ELSE
  403.     BEGIN
  404.      IF DescSaved THEN SetFAttr(DescFile, Archive + Hidden)
  405.                   ELSE Erase(DescFile);       (* Don't keep zero-byte file. *)
  406.      Changed := FALSE;
  407.      DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  408.     END;
  409.   END;  (* If IOResult > 0 then ... else begin *)
  410. END;  (* SaveDescriptions *)
  411.  
  412. (*-------------------------------------------------------- Edit Descriptions *)
  413. PROCEDURE EditDescriptions;
  414.  
  415. CONST kbLeft     = $4B00;   kbRight    = $4D00;
  416.       kbUp       = $4800;   kbDown     = $5000;
  417.       kbHome     = $4700;   kbEnd      = $4F00;
  418.       kbPgUp     = $4900;   kbPgDn     = $5100;
  419.       kbCtrlPgUp = $8400;   kbCtrlPgDn = $7600;
  420.       kbCtrlHome = $7700;   kbCtrlEnd  = $7500;
  421.       kbEnter    = $0D;     kbEsc      = $1B;
  422.  
  423.       kbIns      = $5200;   kbDel      = $5300;
  424.       kbBack     = $08;
  425.  
  426.       kbGrayMinus= $4A2D;   kbGrayPlus = $4E2B;
  427.  
  428.       kbAltC     = $2E00;   kbAltP     = $1900;
  429.       kbAltD     = $2000;   kbAltL     = $2600;
  430.       kbAltM     = $3200;   kbAltT     = $1400;
  431.       kbAltS     = $1F00;   kbAltV     = $2F00;
  432.       kbAltX     = $2D00;
  433.  
  434.       kbF1       = $3B00;   kbF2       = $3C00;
  435.       kbF3       = $3D00;   kbF4       = $3E00;
  436.       kbF5       = $3F00;   kbF6       = $4000;
  437.       kbF10      = $4400;   kbShiftF10 = $5D00;
  438.  
  439. VAR Key          : WORD;
  440.     Drv          : STRING[3];
  441.     LastDrv      : CHAR;
  442.     x,y          : BYTE;
  443.     EditStr      : DescStr;
  444.     Overwrite    : BOOLEAN;
  445.     Cursor       : WORD;
  446.     OldDir       : DirStr;
  447.  
  448.  PROCEDURE UpdateLineNum(Index: INTEGER);
  449.  
  450.  BEGIN
  451.   WriteFileEntry(Index,TRUE);
  452.   TextColor(StatusFg); TextBackGround(StatusBg);
  453.   GotoXY(70,1); Write(Index:3);
  454.  
  455.   IF Changed THEN DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  456.  
  457.   x := 1;
  458.   y := 2+Index-StartIndex;
  459.   GotoXY(EdStart,y);
  460.   TextColor(SelectFg); TextBackGround(SelectBg);
  461.   EditStr := Description[Index].Desc;
  462.   Write(EditStr);
  463.   IF Length(EditStr) < MaxDescLen THEN ClrEol;
  464.   GotoXY(EdStart+x-1,y);
  465.  END;
  466.  
  467.  PROCEDURE PrevIndex(VAR Index: INTEGER);
  468.  
  469.  BEGIN
  470.   Index := Max(Index-1,1);
  471.   IF Index <= StartIndex THEN
  472.    BEGIN
  473.     StartIndex := Max(Index-ScreenSize,0);
  474.     RedrawScreen;
  475.    END;
  476.   UpdateLineNum(Index);
  477.  END; (* NextIndex *)
  478.  
  479.  PROCEDURE NextIndex(VAR Index: INTEGER);
  480.  
  481.  BEGIN
  482.   Index := Min(Index+1,NrOfFiles);
  483.   IF Index > StartIndex+ScreenSize THEN
  484.    BEGIN
  485.     StartIndex := Index-ScreenSize;
  486.     RedrawScreen;
  487.    END;
  488.   UpdateLineNum(Index);
  489.  END; (* NextIndex *)
  490.  
  491.  PROCEDURE QuerySaveDescriptions;
  492.  
  493.  VAR ch: CHAR;
  494.  
  495.  BEGIN
  496.   TextColor(StatusFg); TextBackGround(StatusBg);
  497.   IF Changed THEN
  498.    BEGIN
  499.     REPEAT
  500.      GotoXY(1,MaxLines);
  501.      Write(' Descriptions have been edited. Shall they be saved (Y/N) ?');
  502.      ClrEol;
  503.      ch := UpCase(ReadKey);
  504.     UNTIL (ch = 'Y') OR (ch = 'N');
  505.     IF ch = 'Y' THEN SaveDescriptions;
  506.    END;
  507.  END; (* QuerySaveDescriptions *)
  508.  
  509.  PROCEDURE DirUp;
  510.  
  511.  BEGIN
  512.   IF Changed THEN QuerySaveDescriptions;
  513.   {$I-}
  514.   ChDir('..');
  515.   IF IOResult = 0 THEN
  516.    BEGIN
  517.     ReadFiles;
  518.     RedrawScreen;
  519.  
  520.     DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  521.     Index := 1; UpdateLineNum(Index);
  522.    END;
  523.  END;  (* DirUp *)
  524.  
  525.  PROCEDURE DirDown;
  526.  
  527.  BEGIN
  528.   IF (Description[Index].Size = DirSize) AND
  529.      (Description[Index].Name[1] <> '.') THEN
  530.    BEGIN
  531.     IF Changed THEN QuerySaveDescriptions;
  532.     {$I-}
  533.     ChDir(Description[Index].Name);
  534.     IF IOResult = 0 THEN
  535.      BEGIN
  536.       ReadFiles;
  537.       RedrawScreen;
  538.      END;
  539.     DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  540.     Index := 1;
  541.     UpdateLineNum(Index);
  542.   END;  (* IF Description[Index].Size = DirSize *)
  543.  END;  (* DirDown *)
  544.  
  545. BEGIN  (* EditDescriptions *)
  546.  Index := 1;
  547.  UpdateLineNum(Index);
  548.  Overwrite := FALSE;
  549.  ResetCursor(Overwrite);
  550.  EditStr := Description[Index].Desc;
  551.  
  552.  REPEAT
  553.   Key := GetKey;
  554.   CASE Key OF
  555.    kbUp       : BEGIN
  556.                  Description[Index].Desc := EditStr;
  557.                  WriteFileEntry(Index,FALSE);
  558.                  PrevIndex(Index);
  559.                 END; (* Up *)
  560.  
  561.    kbDown     : BEGIN
  562.                  Description[Index].Desc := EditStr;
  563.                  WriteFileEntry(Index,FALSE);
  564.                  NextIndex(Index);
  565.                 END; (* Down *)
  566.  
  567.    kbLeft     : BEGIN
  568.                  x := Max(1,x-1);
  569.                  GotoXY(EdStart+x-1,y);
  570.                 END; (* Left *)
  571.  
  572.    kbRight    : BEGIN
  573.                  IF (x <= Length(EditStr)) AND (x < MaxDescLen) THEN INC(x);
  574.                  GotoXY(EdStart+x-1,y);
  575.                 END; (* Right *)
  576.  
  577.    kbHome     : BEGIN
  578.                  x := 1;
  579.                  GotoXY(EdStart+x-1,y);
  580.                 END; (* Home *)
  581.  
  582.    kbEnd      : BEGIN
  583.                  x := Length(EditStr);
  584.                  IF x < MaxDescLen THEN INC(x);
  585.                  GotoXY(EdStart+x-1,y);
  586.                  END; (* End *)
  587.  
  588.    kbCtrlEnd  : BEGIN
  589.                  Delete(EditStr,x,MaxDescLen);
  590.                  Description[Index].Desc := EditStr;
  591.  
  592.                  Changed := TRUE;
  593.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  594.  
  595.                  WriteFileEntry(Index,TRUE);
  596.                 END;  (* ^End *)
  597.  
  598.    kbIns      : BEGIN
  599.                  Overwrite := NOT Overwrite;
  600.                  ResetCursor(Overwrite);
  601.                 END; (* Ins *)
  602.  
  603.    kbDel      : BEGIN
  604.                  Delete(EditStr,x,1);
  605.                  Description[Index].Desc := EditStr;
  606.  
  607.                  IF x > Length(EditStr) THEN x := Max(Length(EditStr),1);
  608.  
  609.                  Changed := TRUE;
  610.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  611.  
  612.                  WriteFileEntry(Index,TRUE);
  613.                  GotoXY(EdStart+x-1,y);
  614.                 END; (* Del *)
  615.  
  616.    kbBack     : BEGIN
  617.                  Delete(EditStr,x-1,1);
  618.                  Description[Index].Desc := EditStr;
  619.                  IF x > 1 THEN
  620.                   BEGIN
  621.                    DEC(x);
  622.                    IF x > Length(EditStr) THEN x := Length(EditStr)+1;
  623.                   END;
  624.  
  625.                  Changed := TRUE;
  626.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  627.  
  628.                  WriteFileEntry(Index,TRUE);
  629.                  GotoXY(EdStart+x-1,y);
  630.                 END; (* Back *)
  631.  
  632.    kbPgUp     : BEGIN
  633.                  Description[Index].Desc := EditStr;
  634.                  WriteFileEntry(Index,FALSE);
  635.                  Index := Max(Index-ScreenSize,1);
  636.                  StartIndex := Index-1;
  637.                  RedrawScreen;
  638.                  UpdateLineNum(Index);
  639.                 END; (* PgUp *)
  640.  
  641.    kbPgDn     : BEGIN
  642.                  Description[Index].Desc := EditStr;
  643.                  WriteFileEntry(Index,FALSE);
  644.                  Index := Min(Index+ScreenSize,NrOfFiles);
  645.                  StartIndex := Max(Index-ScreenSize,0);
  646.                  RedrawScreen;
  647.                  UpdateLineNum(Index);
  648.                 END; (* PgDn *)
  649.  
  650.    kbCtrlPgUp : BEGIN
  651.                  Description[Index].Desc := EditStr;
  652.                  WriteFileEntry(Index,FALSE);
  653.                  StartIndex := 0; Index := 1;
  654.                  RedrawScreen;
  655.                  UpdateLineNum(Index);
  656.                 END; (* ^PgUp *)
  657.  
  658.    kbCtrlPgDn : BEGIN
  659.                  Description[Index].Desc := EditStr;
  660.                  WriteFileEntry(Index,FALSE);
  661.                  StartIndex := Max(NrOfFiles-ScreenSize,0);
  662.                  Index := NrOfFiles;
  663.                  RedrawScreen;
  664.                  UpdateLineNum(Index);
  665.                 END; (* ^PgDn *)
  666.  
  667.    kbAltD     : BEGIN
  668.                  Description[Index].Desc := '';
  669.  
  670.                  Changed := TRUE;
  671.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  672.  
  673.                  WriteFileEntry(Index,FALSE);
  674.                  NextIndex(Index);
  675.                 END; (* Alt-D *)
  676.  
  677.    kbAltM,
  678.    kbAltT     : BEGIN
  679.                  CutPasteDesc := Description[Index].Desc;
  680.                  Description[Index].Desc := '';
  681.                  EditStr := '';
  682.  
  683.                  Changed := TRUE;
  684.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  685.                  WriteFileEntry(Index,FALSE);
  686.                  NextIndex(Index);
  687.                 END; (* Alt-M / Alt-T *)
  688.  
  689.    kbAltC     : BEGIN
  690.                  CutPasteDesc := Description[Index].Desc;
  691.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  692.                  WriteFileEntry(Index,TRUE);
  693.                 END; (* Alt-C *)
  694.  
  695.    kbAltP     : IF CutPasteDesc > '' THEN
  696.                  BEGIN
  697.                   Description[Index].Desc := CutPasteDesc;
  698.  
  699.                   Changed := TRUE;
  700.                   DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  701.  
  702.                   WriteFileEntry(Index,FALSE);
  703.                   NextIndex(Index);
  704.                  END; (* Alt-P *)
  705.  
  706.    kbF1       : BEGIN                                   (* F1: Help *)
  707.                  ShowHelp;
  708.                  ResetCursor(Overwrite);
  709.                  DrawMainScreen(Index,NrOfFiles);
  710.                  DrawDirLine;
  711.                  RedrawScreen;
  712.                  UpdateLineNum(Index);
  713.                 END;  (* F1 *)
  714.  
  715.    kbAltL,
  716.    kbF6       : BEGIN                                   (* F6: Change Drive *)
  717.                  IF Changed THEN QuerySaveDescriptions;
  718.  
  719.                  ASM
  720.                   mov ah,0eh       (* Select Disk *)
  721.                   mov dl,3
  722.                   Int 21h
  723.                   add al,'@'
  724.                   mov LastDrv,al
  725.                  END;
  726.  
  727.                  TextColor(StatusFg); TextBackGround(StatusBg); Drv := ' :';
  728.                  REPEAT
  729.                   GotoXY(1,MaxLines);
  730.                   Write(' New drive letter (A..',LastDrv,'): ');
  731.                   ClrEol;
  732.                   Drv[1] := UpCase(ReadKey);
  733.                  UNTIL (Drv[1] >= 'A') AND (Drv[1] <= LastDrv);
  734.                  IF Drv[1] <= 'B' THEN Drv := Drv + '\';
  735.                  OldDir := ActDir;
  736.                  ChDir(Drv); IORes := IOResult;
  737.                  IF IORes = 0 THEN
  738.                   BEGIN
  739.                    GetDir(0,ActDir); IORes := IOResult;
  740.                    TextColor(StatusFg); TextBackGround(StatusBg);
  741.                    GotoXY(1,MaxLines); Write('Scanning directory `',ActDir,'''... wait, please.'); ClrEol;
  742.                    ReadFiles;
  743.                    IF NrOfFiles = 0 THEN
  744.                     BEGIN
  745.                      IF (Length(OldDir) > 3) AND (OldDir[Length(OldDir)] = '\') THEN
  746.                        Delete(OldDir,Length(OldDir),1);
  747.                      ChDir(OldDir);
  748.                      ReportError(' There are no files on drive '+Drv+'. Press any key.',(CutPasteDesc <> ''),Changed);
  749.                      ReadFiles;
  750.                     END;
  751.                    RedrawScreen;
  752.                    DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);;
  753.                    Index := 1;
  754.                    UpdateLineNum(Index);
  755.                   END
  756.                  ELSE
  757.                   ReportError('Drive '+Drv+' not ready! Drive remains unchanged, press a key.',(CutPasteDesc <> ''),Changed);
  758.                 END;  (* F6 *)
  759.  
  760.    kbF4       : DirDown; (* F4 *)
  761.    kbF5       : DirUp;   (* F5 *)
  762.  
  763.    kbEnter    : BEGIN
  764.                  Description[Index].Desc := EditStr;
  765.                  WriteFileEntry(Index,TRUE);
  766.                  IF (Description[Index].Size = DirSize) THEN
  767.                   IF (Description[Index].Name[1] = '.') AND
  768.                      (Description[Index].Name[2] = '.') THEN DirUp
  769.                   ELSE
  770.                   IF Description[Index].Name[1] <> '.'  THEN DirDown;
  771.                 END; (* Enter *)
  772.    kbF10,
  773.    kbF2      : BEGIN                                   (* F10: Save *)
  774.                 SaveDescriptions;
  775.                 UpdateLineNum(Index);
  776.                END; (* F10 or F2 *)
  777.    kbAltS,
  778.    kbShiftF10: BEGIN                                   (* Shell to 4DOS *)
  779.                 NormVideo; ClrScr;
  780.                 WriteLn('Press `Exit'' to return to 4DESC.');
  781.                 SwapVectors;
  782.                 Exec(GetEnv('COMSPEC'),'');
  783.                 SwapVectors;
  784.                 ClrScr;
  785.                 DrawMainScreen(Index,NrOfFiles);
  786.                 DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  787.                 DrawDirLine;
  788.                 RedrawScreen;
  789.                 UpdateLineNum(Index);
  790.                END;
  791.    kbAltV,
  792.    kbF3      : IF (Description[Index].Size <> DirSize) THEN
  793.                 BEGIN                                  (* F3: View File *)
  794.                  SwapVectors;
  795.                  FSplit(Description[Index].Name,NewDir,NewName,NewExt);
  796.                  StripTrailingSpaces(NewName);
  797.                  Exec(GetEnv('COMSPEC'),'/c list '+ActDir+'\'+NewName+NewExt);
  798.                  SwapVectors;
  799.                  ClrScr;
  800.                  DrawMainScreen(Index,NrOfFiles);
  801.                  DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  802.                  DrawDirLine;
  803.                  RedrawScreen;
  804.                  UpdateLineNum(Index);
  805.                END;
  806.   ELSE
  807.    IF (Ord(Key) > 31) AND (Ord(Key) < 256) THEN
  808.     BEGIN
  809.      Changed := TRUE;
  810.      DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  811.  
  812.      IF Overwrite AND (x <= Length(EditStr)) THEN
  813.       EditStr[x] := Chr(Key)
  814.      ELSE
  815.       EditStr := Copy(EditStr,1,x-1)+Chr(Key)+Copy(EditStr,x,255);
  816.      INC(x);
  817.      IF x > MaxDescLen THEN x := MaxDescLen;
  818.  
  819.      Description[Index].Desc := EditStr;
  820.      WriteFileEntry(Index,TRUE);
  821.      GotoXY(EdStart+x-1,y);
  822.     END; (* all others *)
  823.  
  824.   END;  (* case *)
  825.  UNTIL (Key = kbEsc) OR (Key = kbAltX);
  826.  
  827.  IF Changed THEN QuerySaveDescriptions;
  828. END; (* EditDescriptions *)
  829.  
  830. (*-------------------------------------------------------- Main *)
  831. BEGIN
  832.  EdStart := 25+Length(DateFormat)+Length(TimeFormat);
  833.  GetDir(0,StartDir); IORes := IOResult; DoShowHelp := FALSE;
  834.  IF ParamCount > 0 THEN
  835.   BEGIN
  836.    FOR i := 1 TO Min(2,ParamCount) DO
  837.     BEGIN
  838.      FirstParam := ParamStr(i);
  839.      IF (FirstParam[1] = '/') OR (FirstParam[1] = '-') THEN
  840.       BEGIN
  841.        IF NOT Monochrome THEN Monochrome := (UpCase(FirstParam[2]) = 'M');
  842.        IF NOT DoShowHelp THEN DoShowHelp := (UpCase(FirstParam[2]) = 'H') OR
  843.                                             (FirstParam[2] = '?');
  844.       END;
  845.     END;  (* for ... do begin *)
  846.    FSplit(ParamStr(ParamCount), NewDir, NewName, NewExt);
  847.    IF NewDir[Length(NewDir)] = '\' THEN NewDir[Length(NewDir)] := ' ';
  848.    ChDir(NewDir);
  849.   END;  (* if paramcount > 0 *)
  850.  IORes := IOResult;
  851.  Changed := FALSE; CutPasteDesc := '';
  852.  ChooseColors(Monochrome);
  853.  IF DoShowHelp THEN ShowHelp;
  854.  ReadFiles;
  855.  RedrawScreen;
  856.  EditDescriptions;
  857.  ChDir(StartDir);
  858.  SetCursorShape(OrigCursor);
  859.  NormVideo;
  860.  ClrScr;
  861.  WriteLn('4DESC ',ver,' - (c) 1992 Copyright by David Frey & Tom Bowden');
  862.  WriteLn;
  863.  WriteLn('This program is freeware: you are allowed to use, copy it free');
  864.  WriteLn('of charge, but you may not sell or hire 4DESC.');
  865. END.
  866.